#-*- mode: perl; coding:utf-8 -*-
#シーケンス作成ライブラリ

use utf8;
use Encode;
package Sqlib;

# usage
#   Initialize    初期化
#   AddNode       ノード追加

sub Initialize {
    $Debug = 0;                   # debug mode
    $AddUnknownNode = 1;          # Add Unknown node 
    $Debug && print "Sqlib::Initialize\n";
    # 作業領域初期化
    $NumObj = 0;                  # オブジェクト数
    $NumSeq = 0;                  # シーケンス数
    %Targets = ();                # オブジェクト（ID/名称 の連想配列)
    @TargetsName =();             # オブジェクト名
    @SequencesFrom = ();	      # シーケンス送り元
    @SequencesTo = ();		      # シーケンス送り先
    @SequencesMsg = ();		      # シーケンス内容
    @SequencesType = ();	      # シーケンス型
    @SequencesTime =();		      # シーケンス時間
    @SequencesArrowThread = ();   # →のスレッド
#    %SequencesThread =();        # 実行Thread状態(NumSeq,target,thread_id)
    %SequencesCalls = ();         # 実行呼出回数(NumSeq,target) = 回次
    %SequencesThread =();         # 実行Thread状態(NumSeq,target,呼出回次) = thread_id
    %SequencesThreadWait = ();    # 待機中Thread
    $PageX = 0;
	$PageY = 0;
    $MaxPageY = 0;
	$MAX_PAGE = 50;
    $NumThread = 0;
    $FontSize = 10;
#Thread Colors
    @ThreadColors = ("slateblue","orangered", "darkgreen", "DarkOrchid",
                     "YellowGreen","DodgerBlue","Olive","SaddleBrown");
}

## node追加
sub AddNode {
	my ($name) = @_;
	$TargetsName[$NumObj] = $name;
	$Targets{$name} = ($NumObj ++) + 1;
}

## →の追加
sub AddSequence {
    my($from, $to, $msg, $type, $thread_id) = @_;
    my($i,$j);
    $Debug && print "Add Sequences($NumSeq) $from, $to, $msg, $type, $thread_id\n";
    unless ($thread_id) {
        $thread_id = -1;
    }
    unless ($Targets{$from}) {
        if ($AddUnknownNode) {
            &AddNode($from);
        } else {
            return 0;    # 飛び先が含まれない場合なにもしない
        }
    }
    unless ($Targets{$to}) {
        if ($AddUnknownNode) {
            &AddNode($to);
        } else {
            return 0;    # 飛び先が含まれない場合なにもしない
        }
    }

    $SequencesFrom[$NumSeq] = $Targets{$from} - 1;
    $SequencesTo[$NumSeq] = $Targets{$to} - 1;		
    $SequencesMsg[$NumSeq] = $msg;
    if ($type) {
        $SequencesType[$NumSeq] = $type;	
    } else {
        $SequencesType[$NumSeq] = "SYNC";	
    }

    #threadの登録
    &ThreadNo($thread_id);
    $SequencesArrowThread[$NumSeq] = $thread_id;

    $NumSeq++;
    #連続するデータをコピー
    for($j = 0; $j < $NumThread; $j++) {
        $SequencesThreadWait{$NumSeq,$j} = 
            $SequencesThreadWait{$NumSeq-1,$j};
    }
    for($i = 0; $i < $NumObj; $i++){
        $SequencesCalls{$NumSeq,$i} = 
            $SequencesCalls{$NumSeq-1,$i};
    }
    for($i = 0; $i < $NumObj; $i++){
        for($j = 0; $j < $SequencesCalls{$NumSeq,$i}; $j++) {
            $SequencesThread{$NumSeq,$i,$j} = 
                $SequencesThread{$NumSeq-1,$i,$j};
        }
    }
}

sub ThreadNo {
    my ($thread_id) = @_;

    # 登録済みのスレッドでないなら、登録する
    if (! $TargetThreadNo{$thread_id}) {
        $Debug && print "Add Thread $thread_id, $NumThread\n";
		$TargetThreadNo{$thread_id} = $NumThread+1;
		$TargetThreadName[$NumThread] = "[$thread_id]";
		$NumThread++;
    }
    return $TargetThreadNo{$thread_id};
}

# スレッドの名前をつける
sub ThreadName {
    my($thread_id, $Name) = @_;
    my($i);

    if (! $TargetThreadNo{$thread_id}) {
		for ($i = 0; $i < $NumThread ; $i++) {
			if ($TargetThreadName[$i] eq $Name) {
				$TargetThreadNo{$thread_id} = $i+1;
				return;
			}
		}
		$TargetThreadNo{$thread_id} = $NumThread+1;
		$NumThread++;
    }
    $TargetThreadName[$TargetThreadNo{$thread_id} - 1] = $Name;
}

# スレッドの処理に入る
sub EnterThread {
    my ($obj, $thread_id) = @_;
    my ($thread) = &ThreadNo($thread_id);
    
    # 対象オブジェクトの場合、スレッドの追加
    if ($Targets{$obj}) {
        $SequencesCalls{$NumSeq, $Targets{$obj}-1} += 1;
        my $calls = $SequencesCalls{$NumSeq, $Targets{$obj}-1};
		$SequencesThread{$NumSeq, $Targets{$obj}-1, $calls-1} = $thread;
        $SequencesThreadWait{$NumSeq,$thread} = 0;
    }
    $Debug && printf("EnterThread $obj x $SequencesCalls{$NumSeq,$Targets{$obj} - 1} :TID $thread\n");
}

# スレッドの処理から出る
sub ExitThread {
    my ($obj, $thread_id) = @_;
    my ($thread) = $TargetThreadNo{$thread_id};
    my $i;
    if ($Targets{$obj}) {
        for ($i =$SequencesCalls{$NumSeq,$Targets{$obj} - 1}; $i>0; $i--) {
            if ($SequencesThread{$NumSeq,$Targets{$obj} - 1, $i-1} == $thread) {
                $SequencesThread{$NumSeq,$Targets{$obj} - 1, $i-1} = -1;
                last;
            }
		}
        while ($SequencesCalls{$NumSeq,$Targets{$obj} - 1} > 0 &&
               $SequencesThread{$NumSeq,$Targets{$obj} - 1,
                                $SequencesCalls{$NumSeq,$Targets{$obj}-1}-1} == -1) {
            $SequencesCalls{$NumSeq,$Targets{$obj} - 1} --;
        }
        $Debug && printf("ExitThread $obj x $SequencesCalls{$NumSeq,$Targets{$obj} - 1} :TID $thread\n");
    }
}

#スレッドの停止(WaitFor...)
sub WaitThread {
    my($thread_id) = @_;
    if ($TargetThreadNo{$thread_id}) {
		my($thread) = $TargetThreadNo{$thread_id};
		$SequencesThreadWait{$NumSeq,$thread} = 1;
    }
}

#スレッドの再開(WaitFor...の完了)
sub RestartThread {
    my($thread_id) = @_;
    if ($TargetThreadNo{$thread_id}) {
		my($thread) = $TargetThreadNo{$thread_id};
		$SequencesThreadWait{$NumSeq,$thread} = 0;
    }
}

##########################################################################
## Text
##########################################################################
sub MakeText {
    my ($Name) = @_;
	my ($i);
    # Header 
    if ($TIMELINE) {
		printf("TIME  (difference)");
    }
    for($i = 0; $i < $NumObj; $i++) {
		printf("[%-16.16s]", $TargetsName[$i]); 
    }
    printf("\n");
    # Sequences  
    for($i = 0; $i < $NumSeq; $i++) {
		if ($SequencesFrom[$i] == $SequencesTo[$i]) {    # 自分自身に
			if ($TIMELINE) {
				if ($i == 0) {
					printf("%8.8d(%8.8d)", $SequencesTime[$i], 0);
				} else {
					printf("%8.8d(%8.8d)", 
						   $SequencesTime[$i], 
						   $SequencesTime[$i] - $SequencesTime[$i-1]);
				}
			}
			for($j =0; $j < $NumObj; $j++) {
				if ($j != $SequencesFrom[$i]) {
					printf("        │        ");
				} else {
					printf("[%-16.16s]", $SequencesMsg[$i]);
				}
			}
		} elsif ($SequencesFrom[$i] < $SequencesTo[$i]) { #→
			if ($TIMELINE) {
				printf("                  ");
			}
			printf("        ");
			for($j =0; $j < $NumObj; $j++) {
				if ($j == $SequencesFrom[$i]) {
					if (length($SequencesMsg[$i]) > 16) {
						printf("│%-34.34s",$SequencesMsg[$i]);			
						$j++;
					} else {
						printf("│%-16.16s",$SequencesMsg[$i]);
					}
				} else {
					printf("│                ",$SequencesMsg[$i]);
				}
			}
			printf("\n");
			if ($TIMELINE) {
				if ($i == 0) {
					printf("%8.8d(%8.8d)", $SequencesTime[$i], 0);
				} else {
					printf("%8.8d(%8.8d)", 
						   $SequencesTime[$i], 
						   $SequencesTime[$i] - $SequencesTime[$i-1]);
				}
			}
			printf("        ");
			for($j =0; $j < $NumObj; $j++) {
				if ($j == $SequencesFrom[$i]) {
					printf("├────────",$SequencesMsg[$i]);
				} elsif ($j > $SequencesFrom[$i] && $j < $SequencesTo[$i]) {
					printf("┼────────");
				} elsif ($j == $SequencesTo[$i]) {
					printf(">                 ");
				} else {
					printf("│                ");
				}
			}
		} else { # ←
			if ($TIMELINE) {
				printf("                  ");
			}
			printf("        │");
			for($j =1; $j < $NumObj; $j++) {
				if ($j == $SequencesFrom[$i]) {
					if (length($SequencesMsg[$i]) > 16) {
						printf("%-34.34s│",$SequencesMsg[$i]);			
						$j++;
					} else {
						printf("%16.16s│",$SequencesMsg[$i]);
					}
				} else {
					printf("                │",$SequencesMsg[$i]);
				}
			}
			printf("\n");
			if ($TIMELINE) {
				if ($i == 0) {
					printf("%8.8d(%8.8d)", $SequencesTime[$i], 0);
				} else {
					printf("%8.8d(%8.8d)", 
						   $SequencesTime[$i], 
						   $SequencesTime[$i] - $SequencesTime[$i-1]);
				}
			}
			if ($SequencesTo[$i] == 0) {
				printf("         <");
			} else {
				printf("        │");
			}
			for($j =1; $j < $NumObj; $j++) {
				if ($j == $SequencesFrom[$i]) {
					printf("────────┤",$SequencesMsg[$i]);
				} elsif ($j < $SequencesFrom[$i] && $j > $SequencesTo[$i]) {
					printf("────────┼");
				} elsif ($j == $SequencesTo[$i]) {
					printf("                 <");
				} else {
					printf("                │");
				}
			}
		}
		printf("\n");
    }
    printf("\l");    # 改ページ
}

##########################################################################
## SVG(Scalable Vector Graphics)
##########################################################################
sub MakeSVG {
    my ($File) = @_;
    my ($i,$j,$k);
    my ($NumFile) = 0;
    my ($curSeq) = 0;
    my ($curSeqPage) = 0;
    my ($color);
    $Debug && print("MakeSVG $File $NumSeq\n");
#    $File =~ s/([^\.]*)$/svg/;  #拡張子をsvgに変換

    while ($curSeq < $NumSeq) {
		$curSeqPage = $NumSeq - $curSeq;
		if ($curSeqPage > $MAX_PAGE) {
			$curSeqPage = $MAX_PAGE;
		}
		if ($NumFile == 0) {
			open(OUT, ">:utf8", $File) || die "Can't create file $File\n";
		} else {
			$File =~ /(.*)\.svg$/;
			open(OUT, ">:utf8", "$1_$NumFile.svg") || die "Can't create file $1_$NumFile.svg\n";
		}

		# ページの開始
		$PageX = $NumObj * 100;
		$PageY = $curSeqPage * 20 + 30;
        if ($PageY > $MaxPageY) {
            $MaxPageY = $PageY;
        }
		&StartPage($PageX, $PageY + 30);

		# Life Line
		for($i = 50; $i <$PageX; $i +=100) {
			&Line($i, 0, $i, $PageY, 1);
		}
		
		# Header
		for($i = 0; $i <$NumObj; $i++) {
			&TextBoxC($i * 100 + 50 , 0, $TargetsName[$i], "Black");
		}

		# Sequences  
		for($i = 0; $i < $curSeqPage; $i++) {
			$sq = $i + $curSeq;
			#Life Line 
			for ($j = 0; $j < $NumObj; $j++) {
				$shift = 0;
				for ($k = 0; $k <$SequencesCalls{$sq,$j}; $k++) {
					if ($SequencesThread{$sq,$j,$k} > -1) {
                        unless ($SequencesThread{$sq-1,$j,$k}) {
                            &LifeLineHead($j * 100 + 50 + $shift, $i * 20 + 30 - 6,
                                      6,
                                      $ThreadColors[$SequencesThread{$sq,$j,$k}-1],
                                      $SequencesThreadWait{$sq,$SequencesThread{$sq+1,$j,$k}});
                        }
                        if ($SequencesThread{$sq+1,$j,$k} > -1) {
                            &LifeLineMid($j * 100 + 50 + $shift, $i * 20 + 30, 20, 
                                         $ThreadColors[$SequencesThread{$sq,$j,$k}-1],
                                         $SequencesThreadWait{$sq,$SequencesThread{$sq,$j,$k}});
                        } else {
                            &LifeLineTail($j * 100 + 50 + $shift, $i * 20 + 30, 14, 
                                         $ThreadColors[$SequencesThread{$sq,$j,$k}-1],
                                         $SequencesThreadWait{$sq,$SequencesThread{$sq,$j,$k}});
                        }

                    }
                    $shift +=3;
				}
			}
			if ($SequencesFrom[$sq] == $SequencesTo[$sq]) {    # 自分自身に
				if ($SequencesMsg[$sq] =~ /^\#(.*)/) {
					&TextBox($SequencesFrom[$sq] * 100 + 50,
							 $i * 20 + 30,
							 $1);
				} else {
                    # SelfArrow
                    my $call_from = $SequencesCalls{$sq, $SequencesFrom[$sq]};
                    my $call_to  = $SequencesCalls{$sq+1, $SequencesTo[$sq]};
                    my $shift_from = $call_from ? 5 + 3 * ($call_from-1) : 0;
                    my $shift_to = $call_to ? 5 + 3 * ($call_to-1) : 0;
                    if ($SequencesArrowThread[$sq]) {
                        $color = $ThreadColors[$TargetThreadNo{$SequencesArrowThread[$sq]} - 1];
                    } else {
                        $color = "Black";
                    }
                    &SelfArrow($SequencesFrom[$sq] * 100 + 50 + $shift_from,
                               $i * 20 + 30,
                               $shift_to - $shift_from,
                               $SequencesMsg[$sq],
                               $color);
                }
			} else {                                           # 矢印
				if ($SequencesArrowThread[$sq]) {
                    $color = $ThreadColors[$TargetThreadNo{$SequencesArrowThread[$sq]} - 1];
				} else {
                    $color = "Black";
                }
                my $call_from = $SequencesCalls{$sq, $SequencesFrom[$sq]};
                my $call_to  = $SequencesCalls{$sq+1, $SequencesTo[$sq]};
                if ($call_to < $SequencesCalls{$sq, $SequencesTo[$sq]}) {
                    $call_to  = $SequencesCalls{$sq, $SequencesTo[$sq]};
                }
                my $shift_from;
                my $shift_to;
                if ($SequencesFrom[$sq] < $SequencesTo[$sq]) {
                    $shift_from = $call_from ? 5 + 3 * ($call_from - 1) : 0;
                    $shift_to = $call_to ? -5 : 0;
                    &Arrow($SequencesFrom[$sq] * 100 + 50 + $shift_from,
                           $i * 20 + 30, 
                           ($SequencesTo[$sq] - $SequencesFrom[$sq]) *100 + $shift_to - $shift_from,
                           $SequencesMsg[$sq],$SequencesType[$sq],
                           $color);
                } else {
                    $shift_from = $call_from ? -5 : 0;
                    $shift_to = $call_to ? 5 + 3 * ($call_to - 1) : 0;
                    &Arrow($SequencesFrom[$sq] * 100 + 50 + $shift_from,
                           $i * 20 + 30, 
                           ($SequencesTo[$sq] - $SequencesFrom[$sq]) *100 + $shift_to - $shift_from,
                           $SequencesMsg[$sq],$SequencesType[$sq],
                           $color);
                }
            }
        }

		# Footer
        #  - Thread List(Name & Color)
        if ($NumThread >=2) {
            for($i = 0; $i <$NumThread; $i++) {
                &TextBoxC($i * 100 + 50 , $curSeqPage * 20 + 40,
                          $TargetThreadName[$i], $ThreadColors[$i]);
            }
        }

		# End Of Page
		&EndPage();
		close(OUT);			# FILEを閉じる	
		$curSeq += $curSeqPage;
		$NumFile += 1;
    }
    return ($NumFile, $PageX + 50, $MaxPageY + 30);
}

#Pageの始め 
sub StartPage {
    my($width, $height) =@_;
	print OUT <<END_OF_DATA;
<?xml version="1.0" standalone="no"?>
	<svg width="$width" height="$height" version="1.1" xmlns="http://www.w3.org/2000/svg">
		<g transform="scale(1.0)">
END_OF_DATA
}

#テキストボックス（白）
sub TextBox {
    my($x, $y, $text, $type) =@_;
    my($text2) = &XMLText(sprintf("%16.16s", $text));
    my($x2) =$x - 48;
    my($y2) = $y + 14;
	print OUT <<END_OF_DATA;
        <rect x="$x2" y="$y" width="96" height="16" fill="White" stroke="black" />
        <text text-anchor="middle" x="$x" y="$y2" font-size="$FontSize" >
            $text2
        </text>
END_OF_DATA
}

#テキストボックス（黒）
sub TextBoxC {
    my($x, $y, $text, $Color) =@_;
    my($text2) = &XMLText(sprintf("%16.16s", $text));
    my($x2) =$x - 48;
    my($y2) = $y + 14;
	print OUT <<END_OF_DATA;
        <rect x="$x2" y="$y" width="96" height="16" fill="$Color" />
		<text text-anchor="middle" x="$x" y="$y2" font-size="$FontSize" fill="white" >
            $text2
        </text>
END_OF_DATA
}

#線
sub Line {
    my($x1, $y1, $x2, $y2, $width) =@_;
	print OUT <<END_OF_DATA;
        <line x1="$x1" y1="$y1" x2="$x2" y2="$y2" stroke-width="$width" stroke="black" />
END_OF_DATA
}

sub LineColor {
    my ($x1, $y1, $x2, $y2, $width, $Color, $Dot) =@_;

    my $dash = $Dot ? "stroke-dasharray=\"2,2\"" :"";
    my $offset = $y1 % 4;
    my $dashOffset = ($Dot && $offset != 0) ?  "stroke-dashoffset=\"$offset\"" :"";

    print OUT <<END_OF_DATA;
    <line x1="$x1" y1="$y1" x2="$x2" y2="$y2" stroke-width="$width" stroke="$Color" $dash $dashOffset />
END_OF_DATA

}

#矢印
sub Arrow {
    my($x1, $y1, $length, $text, $type, $Color) =@_;
    my($xt,$yt,$x2,$y2,$x3,$y3, $text2);
    if ($Color eq "") { 
		$Color = "black";
    }

    $text2 = &XMLText(sprintf("%32.32s", $text));

    $y1 += 14;
    $yt = $y1 - 1;
    if ($length > 0) { # →
		$xt = $x1 + 4;
		$x2 = $x1 + $length;
		$x3 = $x2 -5;
		$y2 = $y1+2;
		$y3 = $y1-2;
        $anchor = "start";
    } else {           # ←
		$x2 = $x1 + $length;
		$x3 = $x2 +5;
		$y2 = $y1+2;
		$y3 = $y1-2;
		if ($x1 <= 150){
			$xt = $x1 + $length + 4;
			$anchor = "start";
		} else {
			$xt = $x1 - 4;
			$anchor = "end";
		}
    }
    if ($type eq "SYNC") {         # Synchronous
		print OUT <<END_OF_DATA;
        <text text-anchor="$anchor" x="$xt" y="$yt" font-size="$FontSize">
            $text2
        </text>
        <line x1="$x1" y1="$y1" x2="$x2" y2="$y1" stroke-width="1" stroke="$Color" />
        <polygon points="$x2 $y1, $x3 $y2,  $x3 $y3" fill="$Color" />
END_OF_DATA
    } elsif ($type eq "ASYNC") {    # Asynchronous
		$y2 += 2;
		$y3 -= 2;
		print OUT <<END_OF_DATA;
		<text text-anchor="$anchor" x="$xt" y="$yt" font-size="$FontSize">
			$text2
		</text>
		<line x1="$x1" y1="$y1" x2="$x2" y2="$y1" stroke-width="1" stroke="$Color" />
		<polyline points="$x3 $y2, $x2 $y1,  $x3 $y3" stroke="$Color" fill="none" />
END_OF_DATA
    } elsif ($type eq "RET") {   # RETURN 
		print OUT <<END_OF_DATA;
		<text text-anchor="$anchor" x="$xt" y="$yt" font-size="$FontSize">
			$text2
		</text>
		<line x1="$x1" y1="$y1" x2="$x2" y2="$y1" stroke-width="1" stroke="$Color" stroke-dasharray="3,3"/>
		<polygon points="$x2 $y1, $x3 $y2,  $x3 $y3" fill="$Color" />
END_OF_DATA
    }
}

# 自分自身に対する矢印
sub SelfArrow {
    my($x, $y, $shift, $text, $Color) =@_;
    my($text2) = &XMLText(sprintf("%20.20s", $text));
    my($x2) =$x + 30;
    my($y2) = $y + 14;
    my $xto= $x + $shift;
    my $x3 = $xto +5;                                            # ArrowTop
    my $y21 = $y2 +2;
    my $y22 = $y2 -2;
    my $xt = $x2 + 1;                                            # Text pos
    my $yt = $y2 - 1;
    if ($Color eq "") { 
		$Color = "black";
    }

	print OUT <<END_OF_DATA;
        <text text-anchor="start" x="$xt" y="$yt" font-size="$FontSize">
			$text2
		</text>
		<polyline points="$x $y, $x2 $y, $x2 $y2, $xto $y2" stroke="$Color" fill="none" />
		<polygon points="$xto $y2, $x3 $y21,  $x3 $y22" fill="$Color" />
END_OF_DATA
}

# Life Line Head
sub LifeLineHead {
    my ($x, $y, $length, $Color, $Wait) =@_;
    &LineColor($x, $y, $x, $y + $length, 11, "black", $Wait);
    &LineColor($x, $y+1, $x, $y + $length, 9, $Color, $Wait);
}

# Life Line Mid
sub LifeLineMid {
    my ($x, $y, $length, $Color, $Wait) =@_;
    &LineColor($x, $y, $x, $y + $length, 11, "black", $Wait);
    &LineColor($x, $y, $x, $y + $length, 9, $Color, $Wait);
}

# Life Line Tail
sub LifeLineTail {
    my ($x, $y, $length, $Color, $Wait) =@_;
    &LineColor($x, $y, $x, $y + $length, 11, "black", $Wait);
    &LineColor($x, $y, $x, $y + $length-1, 9, $Color, $Wait);
}

#Pageの終わり
sub EndPage {
	print OUT <<END_OF_DATA;
	</g>
</svg>
END_OF_DATA
}

#XMLの特殊文字変換
sub XMLText {
    my($text) =@_;
    $text =~ s/\&/\&amp\;/g; # '&' → '&amp'
    $text =~ s/\</\&lt\;/g; # '<' → '&lt'
    $text =~ s/\>/\&gt\;/g; # '>' → '&gt'
    return ($text);
}

1;
